home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Texteditors / Origami / bindings / fun / towers < prev    next >
Encoding:
Text File  |  1996-09-27  |  13.7 KB  |  521 lines
  1. ;OCL{{{}}}
  2. ;OCL{{{  comments
  3. ; :-)
  4. ; try it
  5. ;OCL}}}
  6. @if-using not(ocl-file-towers)
  7.   @use (ocl-file-towers)
  8.   ;OCL{{{  libs
  9.   @if-using not(ocl-file-delchar) @lib delchar @fi
  10.   @if-using not(ocl-file-error)   @lib error   @fi
  11.   ;OCL}}}
  12.   ( demand-load (
  13.      ;OCL{{{  variables
  14.      ( defvar ( towers-active ) )
  15.      ;OCL}}}
  16.      ;OCL{{{  using a string             - towers-of-hanoi
  17.      ;OCL{{{  vars
  18.      ( defvar
  19.         ( tower-height
  20.           tower-move
  21.           delay-time
  22.         )
  23.      )
  24.      ;OCL}}}
  25.      ;OCL{{{  towers-string
  26.      ;OCL{{{  move towers
  27.      ;OCL{{{  delay
  28.      ( deffun delay ( end-of-line show-cursor delay-time ) )
  29.      ;OCL}}}
  30.      (defmac move-towers (
  31.        if <>(tower-height 0) (
  32.          set tower-height +(tower-height -1)
  33.          ;OCL{{{  handle cases
  34.          if =(tower-move 0)
  35.            ;OCL{{{  0=1->2
  36.            (
  37.            set tower-move 1
  38.            move-towers
  39.            end-of-line
  40.            delete-previous-character
  41.            next-line
  42.            end-of-line
  43.            undo-delete-character
  44.            previous-line
  45.            delay
  46.            set tower-move 5
  47.            move-towers
  48.            )
  49.            ;OCL}}}
  50.          else (
  51.            set tower-move +(tower-move -1)
  52.            if =(tower-move 0)
  53.              ;OCL{{{  1=1->3
  54.              (
  55.              set tower-move 0
  56.              move-towers
  57.              end-of-line
  58.              delete-previous-character
  59.              next-line
  60.              next-line
  61.              end-of-line
  62.              undo-delete-character
  63.              previous-line
  64.              previous-line
  65.              delay
  66.              set tower-move 3
  67.              move-towers
  68.              )
  69.              ;OCL}}}
  70.            else (
  71.              set tower-move +(tower-move -1)
  72.              if =(tower-move 0)
  73.                ;OCL{{{  2=2->1
  74.                (
  75.                set tower-move 3
  76.                move-towers
  77.                next-line
  78.                end-of-line
  79.                delete-previous-character
  80.                previous-line
  81.                end-of-line
  82.                undo-delete-character
  83.                delay
  84.                set tower-move 4
  85.                move-towers
  86.                )
  87.                ;OCL}}}
  88.              else (
  89.                set tower-move +(tower-move -1)
  90.                if =(tower-move 0)
  91.                  ;OCL{{{  3=2->3
  92.                  (
  93.                  set tower-move 2
  94.                  move-towers
  95.                  next-line
  96.                  end-of-line
  97.                  delete-previous-character
  98.                  next-line
  99.                  end-of-line
  100.                  undo-delete-character
  101.                  previous-line
  102.                  previous-line
  103.                  delay
  104.                  set tower-move 1
  105.                  move-towers
  106.                  )
  107.                  ;OCL}}}
  108.                else (
  109.                  set tower-move +(tower-move -1)
  110.                  if =(tower-move 0)
  111.                    ;OCL{{{  4=3->1
  112.                    (
  113.                    set tower-move 5
  114.                    move-towers
  115.                    next-line
  116.                    next-line
  117.                    end-of-line
  118.                    delete-previous-character
  119.                    previous-line
  120.                    previous-line
  121.                    end-of-line
  122.                    undo-delete-character
  123.                    delay
  124.                    set tower-move 2
  125.                    move-towers
  126.                    )
  127.                    ;OCL}}}
  128.                  else
  129.                    ;OCL{{{  5=3->2
  130.                    (
  131.                    set tower-move 4
  132.                    move-towers
  133.                    next-line
  134.                    next-line
  135.                    end-of-line
  136.                    delete-previous-character
  137.                    previous-line
  138.                    end-of-line
  139.                    undo-delete-character
  140.                    previous-line
  141.                    delay
  142.                    set tower-move 0
  143.                    move-towers
  144.                    )
  145.                    ;OCL}}}
  146.                  fi
  147.                )
  148.                fi
  149.              )
  150.              fi
  151.            )
  152.            fi
  153.          ) fi
  154.          ;OCL}}}
  155.          set tower-height +(tower-height 1)
  156.        ) fi
  157.      ))
  158.      ;OCL}}}
  159.      ( deffun towers-string (
  160.        if not(test-text) ( failed ) fi
  161.        beginning-of-line
  162.        newline-and-indent
  163.        previous-line
  164.        "I "  "play "  "the "  "towers "  "of  "  "hanoi
  165.        newline-and-indent
  166.        "==========================
  167.        next-line
  168.        beginning-of-line
  169.        set tower-height 0
  170.        set tower-move   0
  171.        while not(test-end-line)
  172.         ( forward-character set tower-height +(tower-height 1) )
  173.        case
  174.         ( >(-(tower-height 8) 0) ( set delay-time 0 ) )
  175.         ( >(-(tower-height 6) 0) ( set delay-time 1 ) )
  176.         ( >(-(tower-height 4) 0) ( set delay-time 2 ) )
  177.        default
  178.         ( set delay-time 7 )
  179.        esac
  180.        beginning-of-line
  181.        "tower "  "1|
  182.        end-of-line
  183.        newline-and-indent
  184.        "tower "  "2|
  185.        newline-and-indent
  186.        "tower "  "3|
  187.        previous-line
  188.        previous-line
  189.        move-towers
  190.      ))
  191.      ;OCL}}}
  192.      ( deffun towers-of-hanoi
  193.         ( set towers-active true
  194.           towers-string
  195.           set towers-active false
  196.           load-function not( towers-string delay )
  197.         )
  198.      )
  199.      ;OCL{{{  undeclare
  200.      ( undeclare ( tower-height towers-string tower-move delay move-towers ) )
  201.      ;OCL}}}
  202.      ;OCL}}}
  203.      ;OCL{{{  show the towers on display - tower-display
  204.      ;OCL{{{  variables
  205.      ( defvar
  206.         ( t-height
  207.           top-line
  208.           disc-size
  209.           count
  210.           i1
  211.           i2
  212.         )
  213.      )
  214.      ;OCL}}}
  215.      ;OCL{{{  delay
  216.      ( deffun delay ( if not(>(-(t-height 7) 0)) ( show-cursor 1 ) fi ) )
  217.      ;OCL}}}
  218.      ;OCL{{{  show-count
  219.      ( deffun show-count
  220.         ( message ( counter t-height ":  "  counter count "  "moves )
  221.           show-cursor 1
  222.         )
  223.      )
  224.      ;OCL}}}
  225.      ;OCL{{{  base-line
  226.      ( deffun base-line
  227.         ( while not( test-bottom ) ( next-line )
  228.           beginning-of-line
  229.           previous-line
  230.         )
  231.      )
  232.      ;OCL}}}
  233.      ;OCL{{{  go-tower
  234.      ( deffun
  235.         ( to )
  236.           go-tower
  237.         ( goto 1
  238.           repeat +( *( -( to 1 ) +( disc-size 2 ) ) t-height 2 )
  239.            ( forward-character )
  240.         )
  241.      )
  242.      ;OCL}}}
  243.      ;OCL{{{  move-and-display
  244.      ( deffun
  245.         ( move-height from to park )
  246.           move-and-display
  247.         ( if >(move-height 0)
  248.            ( move-and-display ( -( move-height 1 ) from park to )
  249.              ;OCL{{{  move over from-disc
  250.              base-line
  251.              go-tower ( from )
  252.              do
  253.               ( previous-line )
  254.              while test-char "#
  255.              ;OCL}}}
  256.              ;OCL{{{  shift up
  257.              add-mode-overwrite
  258.              next-line
  259.              while <>(-(store-line top-line) 0)
  260.               ( previous-line
  261.                 ;OCL{{{  clear disc
  262.                 screen-off
  263.                 next-line
  264.                 "|
  265.                 repeat move-height ( "  )
  266.                 repeat +( 1 move-height move-height ) ( backward-character )
  267.                 repeat move-height ( "  )
  268.                 screen-on
  269.                 refresh-line
  270.                 ;OCL}}}
  271.                 previous-line
  272.                 ;OCL{{{  draw disc
  273.                 screen-off
  274.                 repeat +( move-height 1 ) ( "# )
  275.                 repeat +( 1 move-height move-height ) ( backward-character )
  276.                 repeat move-height ( "# )
  277.                 screen-on
  278.                 refresh-line
  279.                 ;OCL}}}
  280.                 delay
  281.               )
  282.              delete-mode-overwrite
  283.              ;OCL}}}
  284.              ;OCL{{{  shift left or right
  285.              beginning-of-line
  286.              set i2 5
  287.              set i1 -( to from )
  288.              while >(i1 0)
  289.               ( repeat +( disc-size 2 )
  290.                  ( "  ;
  291.                    if pre ( set i2 -( i2 1 ) ) not(>(i2 0))
  292.                     ( delay
  293.                       set i2 5
  294.                     )
  295.                    fi
  296.                  )
  297.                 set i1 -( i1 1 )
  298.               )
  299.              while <>(i1 0)
  300.               ( repeat +( disc-size 2 )
  301.                  ( delete-previous-character
  302.                    if pre ( set i2 -( i2 1 ) ) not(>(i2 0))
  303.                     ( delay
  304.                       set i2 5
  305.                     )
  306.                    fi
  307.                  )
  308.                 set i1 +( i1 1 )
  309.               )
  310.              ;OCL}}}
  311.              ;OCL{{{  shift down
  312.              add-mode-overwrite
  313.              go-tower ( to )
  314.              next-line
  315.              set i1 "  ;
  316.              do
  317.               ( previous-line
  318.                 ;OCL{{{  clear disc
  319.                 screen-off
  320.                 insert-ascii i1
  321.                 set i1 "|
  322.                 repeat move-height ( "  )
  323.                 repeat +( 1 move-height move-height ) ( backward-character )
  324.                 repeat move-height ( "  )
  325.                 screen-on
  326.                 refresh-line
  327.                 ;OCL}}}
  328.                 next-line
  329.                 ;OCL{{{  draw disc
  330.                 screen-off
  331.                 repeat +( 1 move-height ) ( "# )
  332.                 repeat +( 1 move-height move-height ) ( backward-character )
  333.                 repeat move-height ( "# )
  334.                 screen-on
  335.                 refresh-line
  336.                 ;OCL}}}
  337.                 next-line
  338.               )
  339.              while test-char "|
  340.              delete-mode-overwrite
  341.              ;OCL}}}
  342.              set count +( count 1 )
  343.              show-count
  344.              move-and-display ( -( move-height 1 ) park to from )
  345.            )
  346.           fi
  347.         )
  348.      )
  349.      ;OCL}}}
  350.      ;OCL{{{  tower-mac-dsp
  351.      ( deffun tower-mac-dsp
  352.         (
  353.           ;OCL{{{  get size
  354.           set t-height read-repeat
  355.           if <=(t-height 0) ( set t-height 5 ) fi
  356.           set disc-size +( 1 t-height t-height )
  357.           ;OCL}}}
  358.           ;OCL{{{  draw tower
  359.           screen-off
  360.           add-mode-overwrite
  361.           end-of-fold
  362.           beginning-of-line
  363.           repeat +( 4 t-height ) ( newline-and-indent )
  364.           ;OCL{{{  show base-line
  365.           base-line
  366.           repeat +( 2 *( 3 +( disc-size 2 ) ) ) ( "= )
  367.           ;OCL}}}
  368.           ;OCL{{{  draw sticks and discs
  369.           set i1 1
  370.           set i2 disc-size
  371.           do
  372.            (
  373.              ;OCL{{{  move to line
  374.              base-line
  375.              local
  376.               ( i1 )
  377.               ( do
  378.                  ( previous-line
  379.                    set i1 -( i1 1)
  380.                  )
  381.                 while >(i1 0)
  382.               )
  383.              ;OCL}}}
  384.              ;OCL{{{  draw sticks
  385.              go-tower ( 1 )
  386.              "|
  387.              go-tower ( 2 )
  388.              "|
  389.              go-tower ( 3 )
  390.              "|
  391.              ;OCL}}}
  392.              if >(-( i2 1 ) 0)
  393.               ;OCL{{{  draw disc
  394.               ( go-tower ( 1 )
  395.                 repeat div( i2 2 )
  396.                  ( backward-character )
  397.                 repeat i2
  398.                  ( "# )
  399.               )
  400.               ;OCL}}}
  401.              fi
  402.              set i1 +( i1 1 )
  403.              set i2 -( i2 2 )
  404.              set top-line -( store-line 1 )
  405.            )
  406.           while >(i2 0)
  407.           ;OCL}}}
  408.           delete-mode-overwrite
  409.           ;OCL{{{  scroll towers out and in again
  410.           base-line
  411.           ;OCL{{{  get scroll width
  412.           set i1 +( 2 *( 3 +( disc-size 2 ) ) )
  413.           if >(-( screen-width i1 ) 0)
  414.            ( set i1 screen-width )
  415.           fi
  416.           ;OCL}}}
  417.           ;OCL{{{  scroll out
  418.           while <>(top-line store-line)
  419.            ( repeat i1 ( "  backward-character )
  420.              previous-line
  421.            )
  422.           ;OCL}}}
  423.           ;OCL{{{  scroll in
  424.           screen-on
  425.           redraw-display
  426.           repeat i1
  427.            ( screen-off
  428.              goto-line-counter +( top-line 1 )
  429.              do
  430.               (
  431.                 ;OCL{{{  line from right
  432.                 goto 1
  433.                 delete-character
  434.                 next-line
  435.                 ;OCL}}}
  436.                 ;OCL{{{  line from left
  437.                 if not( test-bottom )
  438.                  ( goto +( i1 i1 )
  439.                    if test-end-line
  440.                     ;OCL{{{  space at front
  441.                     ( goto 1 "  )
  442.                     ;OCL}}}
  443.                    else
  444.                     ;OCL{{{  last char at front
  445.                     ( delete-character
  446.                       goto 1
  447.                       undo-delete-character
  448.                     )
  449.                     ;OCL}}}
  450.                    fi
  451.                    next-line
  452.                  )
  453.                 fi
  454.                 ;OCL}}}
  455.               )
  456.              while not( test-bottom )
  457.              screen-on
  458.              redraw-display
  459.              show-cursor 0
  460.            )
  461.           redraw-display
  462.           ;OCL}}}
  463.           delay
  464.           ;OCL}}}
  465.           ;OCL}}}
  466.           ;OCL{{{  do the move!
  467.           set count 0
  468.           move-and-display ( t-height 1 3 2 )
  469.           redraw-display
  470.           show-count
  471.           ;OCL}}}
  472.         )
  473.      )
  474.      ;OCL}}}
  475.  
  476.      ( deffun tower-display
  477.         ( set towers-active true
  478.           load-function
  479.            ( tower-mac-dsp
  480.              move-and-display
  481.              go-tower
  482.              base-line
  483.              show-count
  484.              delay
  485.            )
  486.           tower-mac-dsp
  487.           set towers-active false
  488.           load-function not
  489.            ( tower-mac-dsp
  490.              move-and-display
  491.              go-tower
  492.              base-line
  493.              show-count
  494.              delay
  495.            )
  496.         )
  497.      )
  498.      ;OCL{{{  undeclare
  499.      ( undeclare
  500.         ( t-height
  501.           count
  502.           top-line
  503.           disc-size
  504.           i1
  505.           i2
  506.           delay
  507.           go-tower
  508.           base-line
  509.           show-count
  510.           tower-mac-dsp
  511.           move-and-display
  512.         )
  513.      )
  514.      ;OCL}}}
  515.      ;OCL}}}
  516.      ;OCL{{{  undeclares
  517.      ( undeclare ( towers-active ) )
  518.      ;OCL}}}
  519.   ) )
  520. @fi
  521.